SpatialAverage.f90 Source File
Compute average value of grid data over a given area
Source Code
!! Compute average value of grid data over a given area !|author: <a href="mailto:giovanni.ravazzani@polimi.it">Giovanni Ravazzani</a> ! license: <a href="http://www.gnu.org/licenses/">GPL</a> ! !### History ! ! current version 1.4 - 3rd February 2023 ! ! | version | date | comment | ! |----------|-------------|----------| ! | 1.0 | 02/Dec/2016 | Original code | ! | 1.1 | 16/May/2019 | added interception and plants dynamic variables | ! | 1.2 | 16/Jun/2021 | rewritten to manage new meteo configuration | ! | 1.3 | 18/Jan/2023 | module renamed from ArealAverage to SpatialAverage | ! | 1.4 | 03/Feb/2023 | modified to not open file if dtoutspatial = 0 | ! !### License ! license: GNU GPL <http://www.gnu.org/licenses/> ! !### Module Description ! routines to compute average value of grid data over a given area ! For every spatial extent, the average is computed and exported ! on file of the variables chosen by user in the configuration file. ! The configuration file includes specific sections ! for **_Meteorological input_**, ! **_Soil balance_**, **_Snow_**, **_Glacier_**, ! **_Canopy interception_**, **_Plants_**, and ! **_Sediment_** erosion and transport variables, ! as in the examples below. !``` ! epsg = 32632 ! ! Table Start ! Title: mask grids for output ! Id: masks ! Columns: [count] [id] [name] [file] ! Units: [-] [-] [-] [-] ! 1 01 lago "./bacino_lago.asc" ! 2 02 gavardo "./gavardo.asc" ! 3 03 mezzane "./bacino_mezzane.asc" ! 4 04 asola "./bacino_asola.asc" ! Table End ! ! [meteo] ! precipitation = 1 # gross precipitation (mm) ! daily-precipitation = 0 # daily precipitation(mm) ! temperature = 1 # air temperature(°C) ! temperature-daily-mean = 1 # mean daily temperature (°C) ! temperature-daily-max = 1 # maximum daily temperature (°C) ! temperature-daily-min = 1 # minimum daily temperature (°C) ! relative-humidity = 0 # air relative humidity (% [0-1]) ! solar-radiation = 0 # shortwave radiation (w/m2) ! net-radiation = 0 # net radiation (w/m2) ! wind-speed = 0 # wind speed (m/s) ! irrigation = 0 # irrigation amount (mm) ! ! [soil-balance] ! soil-moisture = 1 # soil moisture(m3/m3) ! runoff = 1 # runoff(mm) ! infiltration = 1 # infiltration(mm) ! percolation = 1 # percolation(mm) ! actual-ET = 1 # actual evapotranspiration(mm) ! potential-ET = 1 # potential evapotranspiration(mm) ! capillary-rise = 0 # capillary flux(mm) ! error = 1 # balance error (mm) ! ! [snow] ! rain = 1 # liquid precipitation(mm) ! snow-water-equivalent = 1 # snow water equivalent(mm) ! melt-coefficient = 1 # snow melt coefficient (mm/day/°C) ! snow-covered-area = 1 # percentage of snow cover (0-1) ! water-in-snow = 1 # water in snowpack (mm) ! snow-melt = 1 # snow melt (mm) ! ! [glacier] ! ice-water-equivalent = 1 # snow water equivalent(mm) ! ice-covered-area = 1 # percentage of glacial cover (0-1) ! water-in-ice = 1 # water in glaciers (mm) ! ice-melt = 1 # ice melt (mm) ! ! [sediment] ! detachment-rate = 0 # eroded sediment amount (kg) ! ! [canopy] ! canopy-storage = 0 # canopy water storage (mm) ! throughfall = 0 # canopy throughfall (mm) ! transpiration = 0 # canopy transpiration (mm) ! ! [plants] ! lai = 0 # leaf area index (m2/m2) ! gpp = 0 # gross primary production (t) ! npp = 0 # net primary production (t) ! stem = 0 # stem mass (t) ! root = 0 # root mass (t) ! leaf = 0 # leaf mass (t) ! cover = 0 # canopy cover (0-1) ! dbh = 0 # plant diameter at brest height (cm) ! height = 0 # plant heigth (m) ! density = 0 # plant density (tree/hectare) ! stem-yield = 0 # stem yield (t) !``` ! ! The value is computed for all variables marked with 1. ! When one variable is marked by 1 but it is not allocated ! because not computed by the FEST model according to options ! defined in the configuration files, value is not exported. ! For example, if user set to export wind speed in the ! meteorological section but wind speed is not used in ! the current simulation, values of wind speed are ! not written in the output file. ! The name of output files is the concatenation of result ! folder name defined in the main configuration file <folder>, ! the name of the spatial extent <name>, and a suffix recalling ! the process related to the variables, as listed in the following table. ! ! | variables | Output file name | ! |----------------|-------------------------------------| ! | meteorological | `<folder>` `<name>` `_meteo.out` | ! | soil balance | `<folder>` `<name>` `_balance.out` | ! | snow | `<folder>` `<name>` `_snow.out` | ! | glaciers | `<folder>` `<name>` `_glaciers.out` | ! | sediment | `<folder>` `<name>` `_sediment.out` | ! | canopy | `<folder>` `<name>` `_canopy.out` | ! | plants | `<folder>` `<name>` `_plants.out` | ! MODULE SpatialAverage ! Modules used: USE DataTypeSizes, ONLY : & ! Imported Parameters: float, short USE GridLib, ONLY : & !imported definitions: grid_integer, grid_real, & !Imported routines: NewGrid, ExportGrid,& !Imported parameters: ESRI_ASCII USE GridStatistics, ONLY : & !imported routines: GetMean, GetSum USE GridOperations, ONLY : & !imported routines CellArea USE Chronos, ONLY : & !Imported definitions: DateTime, & !Imported variables: timeString, & !Imported operands: ASSIGNMENT( = ) USE IniLib, ONLY: & !Imported derived types: IniList, & !Imported routines: IniOpen, IniClose, & IniReadInt USE Loglib, ONLY : & !Imported routines: Catch USE TableLib, ONLY : & !Imported definitions: Table, & !Imported routines: TableNew, TableGetNrows, TableGetValue USE GeoLib, ONLY: & !imported routines: DecodeEPSG, & !DEBUG ASSIGNMENT( = ) USE Utilities, ONLY : & !imported routines: GetUnit IMPLICIT NONE !variable definitions TYPE Extent !PRIVATE CHARACTER (LEN = 100) :: id CHARACTER (LEN = 100) :: name TYPE (grid_integer) :: mask REAL (KIND = float) :: area !!surface area (m2) !file unit INTEGER (KIND = short) :: unitmeteo INTEGER (KIND = short) :: unitbalance INTEGER (KIND = short) :: unitsnow INTEGER (KIND = short) :: unitice INTEGER (KIND = short) :: unitsediment INTEGER (KIND = short) :: unitcanopy INTEGER (KIND = short) :: unitplants !file name CHARACTER (LEN = 1000) :: filemeteo CHARACTER (LEN = 1000) :: filebalance CHARACTER (LEN = 1000) :: filesnow CHARACTER (LEN = 1000) :: fileice CHARACTER (LEN = 1000) :: filesediment CHARACTER (LEN = 1000) :: filecanopy CHARACTER (LEN = 1000) :: fileplants !average values REAL (KIND = float), ALLOCATABLE :: meteo (:) REAL (KIND = float), ALLOCATABLE :: balance (:) REAL (KIND = float), ALLOCATABLE :: snow (:) REAL (KIND = float), ALLOCATABLE :: ice (:) REAL (KIND = float), ALLOCATABLE :: sediment (:) REAL (KIND = float), ALLOCATABLE :: canopy (:) REAL (KIND = float), ALLOCATABLE :: plants (:) END TYPE Extent !active output and header LOGICAL :: meteoout (11) !1 = precipitation, !2 = daily-precipitation, !3 = air-temperature, !4 = air-temperature-daily-mean, !5 = air-temperature-daily-max !6 = air-temperature-daily-min !7 = relative-humidity !8 = solar-radiation, !9 = net-radiation !10 = wind-speed !11 = irrigation CHARACTER (LEN = 40) :: meteoheader (11) = (/ 'precipitation_mm', & !1 'precipitation_daily_mm', & !2 'air-temperature_Celsius', & !3 'air-temperature-daily-mean_Celsius', & !4 'air-temperature-daily-max_Celsius', & !5 'air-temperature-daily-min_Celsius', & !6 'relative-humidity_0-100', & !7 'solar-radiation_wm-2', & !8 'net-radiation_wm-2', & !9 'wind-speed_ms-1' , & !10 'irrigation_mm' /) !11 LOGICAL :: balanceout (10) !1=soil-moisture, 2=soil-moisture-rz, 3=soil-moisture-tz, !4 =runoff, 5=infiltration,6=percolation, !7=actual evapotranspiration, 8 = PET, 9 = capillary rise, !10=error CHARACTER (LEN = 30) :: balanceheader (10) = (/ 'soil-moisture', & !1 'soil-moisture-rz', & !2 'soil-moisture-tz', & !3 'runoff_mm', & !4 'infiltration_mm', & !5 'percolation_mm', & !6 'actual_ET_mm', & !7 'PET_mm', & !8 'capillary-rise_mm', & !9 'error_mm'/) !10 LOGICAL :: snowout (6) !1=liquid-precipitation, 2= snow-water-equivalent, 3=melt-coefficient, !4 =snow-covered-area, 5=water-in-snow, 6=snow-melt CHARACTER (LEN = 30) :: snowheader (6) = (/ 'liquid-precipitation_mm', & 'snow-water-equivalent_mm', & 'melt-coefficient_mm/day/C', & 'snow-covered-area_01', & 'water-in-snow_mm', & 'snow-melt_mm' /) LOGICAL :: iceout (4) !1=ice-water-equivalent, 2=glacier-covered-area, !3=water-in-ice, 4=ice-melt CHARACTER (LEN = 30) :: iceheader (4) = (/ 'ice-water-equivalent_mm', & 'glacier-covered-area_0-1', & 'water-in-ice_mm', & 'ice-melt_mm' /) LOGICAL :: sedimentout (1) !1=erosion CHARACTER (LEN = 30) :: sedimentheader (1) = (/ 'erosion_kg' /) LOGICAL :: canopyout (3) !1=canopy-storage, 2=throughfall, 3=transpiration CHARACTER (LEN = 30) :: canopyheader (3) = (/ 'canopy-storage_mm', & 'throughfall_mm', & 'canopy-transpiration_mm' /) LOGICAL :: plantsout (11) !1=lai, 2 = GPP, 3 = NPP, 4 = stem-mass, 5 = root-mass, 6 = leaf-mass, !7 = canopy-cover, 8 = dbh, 9 = height, 10 = density, 11 = stem-yield CHARACTER (LEN = 30) :: plantsheader (11) = (/ 'LAI', & 'GPP_t', & 'NPP_t', & 'stem-mass_t', & 'root-mass_t', & 'leaf-mass_t', & 'canopy-cover_0-1', & 'DBH_cm', & 'Height_m', & 'density_tree-per-hectare', & 'stem-yield_t' /) !times TYPE (DateTime) :: timeSpatialAverageMeteo TYPE (DateTime) :: timeSpatialAverageBalance TYPE (DateTime) :: timeSpatialAverageSnow TYPE (DateTime) :: timeSpatialAverageIce TYPE (DateTime) :: timeSpatialAverageSediment TYPE (DateTime) :: timeSpatialAverageCanopy TYPE (DateTime) :: timeSpatialAveragePlants !Public routines PUBLIC :: InitSpatialAverageMeteo PUBLIC :: InitSpatialAverageBalance PUBLIC :: InitSpatialAverageSnow PUBLIC :: InitSpatialAverageGlaciers PUBLIC :: InitSpatialAverageSediment PUBLIC :: InitSpatialAverageCanopy PUBLIC :: InitSpatialAveragePlants PUBLIC :: ComputeSpatialAverageMeteo PUBLIC :: ComputeSpatialAverageBalance PUBLIC :: ComputeSpatialAverageSnow PUBLIC :: ComputeSpatialAverageGlaciers PUBLIC :: ComputeSpatialAverageSediment PUBLIC :: ComputeSpatialAverageCanopy PUBLIC :: ComputeSpatialAveragePlants PUBLIC :: ExportSpatialAverageMeteo PUBLIC :: ExportSpatialAverageBalance PUBLIC :: ExportSpatialAverageSnow PUBLIC :: ExportSpatialAverageGlaciers PUBLIC :: ExportSpatialAverageSediment PUBLIC :: ExportSpatialAverageCanopy PUBLIC :: ExportSpatialAveragePlants !private declarations TYPE (Table), PRIVATE :: extent_table TYPE (Extent), PRIVATE, ALLOCATABLE :: extents (:) !store extents information INTEGER (KIND = short), PRIVATE :: nextents !number of extents INTEGER (KIND = short), PRIVATE :: countmeteo !!count number of meteo variables active for output INTEGER (KIND = short), PRIVATE :: countbalance !!count number of soil balance variables active for output INTEGER (KIND = short), PRIVATE :: countsnow !!count number of snow variables active for output INTEGER (KIND = short), PRIVATE :: countice !!count number of glaciers variables active for output INTEGER (KIND = short), PRIVATE :: countsediment !!count number of sediment variables active for output INTEGER (KIND = short), PRIVATE :: countcanopy !!count number of canopy variables active for output INTEGER (KIND = short), PRIVATE :: countplants !!count number of plants variables active for output LOGICAL, PRIVATE :: meteoInitialized = .FALSE. LOGICAL, PRIVATE :: balanceInitialized = .FALSE. LOGICAL, PRIVATE :: snowInitialized = .FALSE. LOGICAL, PRIVATE :: iceInitialized = .FALSE. LOGICAL, PRIVATE :: sedimentInitialized = .FALSE. LOGICAL, PRIVATE :: canopyInitialized = .FALSE. LOGICAL, PRIVATE :: plantsInitialized = .FALSE. !private routines PRIVATE :: ConfigureExtents !======= CONTAINS !======= ! Define procedures contained in this module. !============================================================================== !| Description: ! Initialization of spatial average of meteorological variables SUBROUTINE InitSpatialAverageMeteo & ! (fileini, pathout, temp, tmean, tmax, tmin, precipitation, & rh, radiation, netradiation, windspeed, daily_precipitation, & irrigation ) IMPLICIT NONE !arguments with intent in: CHARACTER(LEN = *), INTENT(IN) :: fileini CHARACTER(LEN = *), INTENT(IN) :: pathout TYPE (grid_real), INTENT(IN) :: temp !!air temperarure (°C) TYPE (grid_real), INTENT(IN) :: tmean !!air temperarure daily mean(°C) TYPE (grid_real), INTENT(IN) :: tmax !!air temperarure daily max (°C) TYPE (grid_real), INTENT(IN) :: tmin !!air temperarure daily min (°C) TYPE (grid_real), INTENT(IN) :: precipitation !!precipitation rate (m/s) TYPE (grid_real), INTENT(IN) :: rh !!air relative humidity (0-100) TYPE (grid_real), INTENT(IN) :: radiation !!solar radiation (w/m2) TYPE (grid_real), INTENT(IN) :: netradiation !!net radiation (w/m2) TYPE (grid_real), INTENT(IN) :: windspeed !!wind speed (m/s) TYPE (grid_real), INTENT(IN) :: daily_precipitation !!daily precipitation rate (m/s) TYPE (grid_real), INTENT(IN) :: irrigation !!irrigation rate (m/s) !local declarations TYPE(IniList) :: iniDB !-------------------------------end of declaration----------------------------- ! open and read configuration file CALL IniOpen (fileini, iniDB) ! search for active variable for output CALL Catch ('info', 'SpatialAverage', 'checking for meteo active variables ') countmeteo = 0 !precipitation IF ( IniReadInt ('precipitation', iniDB, section = 'meteo') == 1) THEN IF ( .NOT. ALLOCATED (precipitation % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'precipitation not allocated, & forced to not export spatial average ') meteoout (1) = .FALSE. ELSE meteoout (1) = .TRUE. countmeteo = countmeteo + 1 END IF ELSE meteoout (1) = .FALSE. END IF !daily precipitation IF ( IniReadInt ('daily-precipitation', iniDB, section = 'meteo') == 1) THEN IF ( .NOT. ALLOCATED (daily_precipitation % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'daily precipitation not allocated, & forced to not export spatial average ') meteoout (2) = .FALSE. ELSE meteoout (2) = .TRUE. countmeteo = countmeteo + 1 END IF ELSE meteoout (2) = .FALSE. END IF !air temperature IF ( IniReadInt ('temperature', iniDB, section = 'meteo') == 1) THEN IF ( .NOT. ALLOCATED (temp % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'air temperature not allocated, & forced to not export spatial average ') meteoout (3) = .FALSE. ELSE meteoout (3) = .TRUE. countmeteo = countmeteo + 1 END IF ELSE meteoout (3) = .FALSE. END IF !daily mean air temperature IF ( IniReadInt ('temperature-daily-mean', iniDB, section = 'meteo') == 1) THEN IF ( .NOT. ALLOCATED (tmean % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'daily mean temperature not allocated, & forced to not export spatial average ') meteoout (4) = .FALSE. ELSE meteoout (4) = .TRUE. countmeteo = countmeteo + 1 END IF ELSE meteoout (4) = .FALSE. END IF !daily maximum air temperature IF ( IniReadInt ('temperature-daily-max', iniDB, section = 'meteo') == 1) THEN IF ( .NOT. ALLOCATED (tmax % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'daily maximum temperature not allocated, & forced to not export spatial average ') meteoout (5) = .FALSE. ELSE meteoout (5) = .TRUE. countmeteo = countmeteo + 1 END IF ELSE meteoout (5) = .FALSE. END IF !daily minimum air temperature IF ( IniReadInt ('temperature-daily-min', iniDB, section = 'meteo') == 1) THEN IF ( .NOT. ALLOCATED (tmin % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'daily minimum temperature not allocated, & forced to not export spatial average ') meteoout (6) = .FALSE. ELSE meteoout (6) = .TRUE. countmeteo = countmeteo + 1 END IF ELSE meteoout (6) = .FALSE. END IF !relative humidity IF ( IniReadInt ('relative-humidity', iniDB, section = 'meteo') == 1) THEN IF ( .NOT. ALLOCATED (rh % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'rh not allocated, & forced to not export spatial average ') meteoout (7) = .FALSE. ELSE meteoout (7) = .TRUE. countmeteo = countmeteo + 1 END IF ELSE meteoout (7) = .FALSE. END IF ! solar radiation IF ( IniReadInt ('solar-radiation', iniDB, section = 'meteo') == 1) THEN IF ( .NOT. ALLOCATED (radiation % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'radiation not allocated, & forced to not export spatial average ') meteoout (8) = .FALSE. ELSE meteoout (8) = .TRUE. countmeteo = countmeteo + 1 END IF ELSE meteoout (8) = .FALSE. END IF ! net radiation IF ( IniReadInt ('net-radiation', iniDB, section = 'meteo') == 1) THEN IF ( .NOT. ALLOCATED (netradiation % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'net radiation not allocated, & forced to not export spatial average ') meteoout (9) = .FALSE. ELSE meteoout (9) = .TRUE. countmeteo = countmeteo + 1 END IF ELSE meteoout (9) = .FALSE. END IF !wind speed IF ( IniReadInt ('wind-speed', iniDB, section = 'meteo') == 1) THEN IF ( .NOT. ALLOCATED (windspeed % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'windspeed not allocated, & forced to not export spatial average ') meteoout (10) = .FALSE. ELSE meteoout (10) = .TRUE. countmeteo = countmeteo + 1 END IF ELSE meteoout (10) = .FALSE. END IF !irrigation IF ( IniReadInt ('irrigation', iniDB, section = 'meteo') == 1) THEN IF ( .NOT. ALLOCATED (irrigation % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'irrigation not allocated, & forced to not export spatial average ') meteoout (11) = .FALSE. ELSE meteoout (11) = .TRUE. countmeteo = countmeteo + 1 END IF ELSE meteoout (11) = .FALSE. END IF meteoInitialized = .TRUE. CALL IniClose (iniDB) CALL ConfigureExtents (fileini, pathout) RETURN END SUBROUTINE InitSpatialAverageMeteo !============================================================================== !| Description: ! Initialization of spatial average of soil balance variables SUBROUTINE InitSpatialAverageBalance & ! (fileini, pathout, sm, smrz, smtz, runoff, infrate, perc, et, pet, & caprise, error) IMPLICIT NONE !arguments with intent in: CHARACTER(LEN = *), INTENT(IN) :: fileini CHARACTER(LEN = *), INTENT(IN) :: pathout TYPE (grid_real), INTENT(IN) :: sm !!mean soil moisture (m3/m3) TYPE (grid_real), INTENT(IN) :: smrz !!root zone soil moisture (m3/m3) TYPE (grid_real), INTENT(IN) :: smtz !!transmission moisture (m3/m3) TYPE (grid_real), INTENT(IN) :: runoff !!runoff rate (m/s) TYPE (grid_real), INTENT(IN) :: infrate !!infiltration rate (m/s) TYPE (grid_real), INTENT(IN) :: perc !!percolation (m/s) TYPE (grid_real), INTENT(IN) :: et !!actual evapotranspiration rate (m/s) TYPE (grid_real), INTENT(IN) :: pet !!potential evapotranspiration rate (m/s) TYPE (grid_real), INTENT(IN) :: caprise !!actual evapotranspiration rate (m/s) TYPE (grid_real), INTENT(IN) :: error !! balance error (mm) !local declarations TYPE(IniList) :: iniDB !-------------------------------end of declaration----------------------------- ! open and read configuration file CALL IniOpen (fileini, iniDB) ! search for active variable for output CALL Catch ('info', 'SpatialAverage', 'checking for balance active variables ') countbalance = 0 !mean soil volumetric water content IF ( IniReadInt ('soil-moisture', iniDB, section = 'soil-balance') == 1) THEN IF ( .NOT. ALLOCATED (sm % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'soil mositure not allocated, & forced to not export spatial average ') balanceout (1) = .FALSE. ELSE balanceout (1) = .TRUE. countbalance = countbalance + 1 END IF ELSE balanceout (1) = .FALSE. END IF !root zone volumetric water content IF ( IniReadInt ('soil-moisture-rz', iniDB, section = 'soil-balance') == 1) THEN IF ( .NOT. ALLOCATED (smrz % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'soil mositure rz not allocated, & forced to not export spatial average ') balanceout (2) = .FALSE. ELSE balanceout (2) = .TRUE. countbalance = countbalance + 1 END IF ELSE balanceout (2) = .FALSE. END IF !transmission zone volumetric water content IF ( IniReadInt ('soil-moisture-tz', iniDB, section = 'soil-balance') == 1) THEN IF ( .NOT. ALLOCATED (smtz % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'soil mositure tz not allocated, & forced to not export spatial average ') balanceout (3) = .FALSE. ELSE balanceout (3) = .TRUE. countbalance = countbalance + 1 END IF ELSE balanceout (3) = .FALSE. END IF !runoff IF ( IniReadInt ('runoff', iniDB, section = 'soil-balance') == 1) THEN IF ( .NOT. ALLOCATED (runoff % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'runoff not allocated, & forced to not export spatial average ') balanceout (4) = .FALSE. ELSE balanceout (4) = .TRUE. countbalance = countbalance + 1 END IF ELSE balanceout (4) = .FALSE. END IF !infiltration IF ( IniReadInt ('infiltration', iniDB, section = 'soil-balance') == 1) THEN IF ( .NOT. ALLOCATED (infrate % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'infiltration not allocated, & forced to not export spatial average ') balanceout (5) = .FALSE. ELSE balanceout (5) = .TRUE. countbalance = countbalance + 1 END IF ELSE balanceout (5) = .FALSE. END IF !percolation IF ( IniReadInt ('percolation', iniDB, section = 'soil-balance') == 1) THEN IF ( .NOT. ALLOCATED (perc % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'percolation not allocated, & forced to not export spatial average ') balanceout (6) = .FALSE. ELSE balanceout (6) = .TRUE. countbalance = countbalance + 1 END IF ELSE balanceout (6) = .FALSE. END IF !actual evapotranspiration IF ( IniReadInt ('actual-ET', iniDB, section = 'soil-balance') == 1) THEN IF ( .NOT. ALLOCATED (et % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'et not allocated, & forced to not export spatial average ') balanceout (7) = .FALSE. ELSE balanceout (7) = .TRUE. countbalance = countbalance + 1 END IF ELSE balanceout (7) = .FALSE. END IF !potential evapotranspiration IF ( IniReadInt ('potential-ET', iniDB, section = 'soil-balance') == 1) THEN IF ( .NOT. ALLOCATED (pet % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'pet not allocated, & forced to not export spatial average ') balanceout (8) = .FALSE. ELSE balanceout (8) = .TRUE. countbalance = countbalance + 1 END IF ELSE balanceout (8) = .FALSE. END IF !capillary rise IF ( IniReadInt ('capillary-rise', iniDB, section = 'soil-balance') == 1) THEN IF ( .NOT. ALLOCATED (caprise % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'capillary rise not allocated, & forced to not export spatial average ') balanceout (9) = .FALSE. ELSE balanceout (9) = .TRUE. countbalance = countbalance + 1 END IF ELSE balanceout (9) = .FALSE. END IF !balance error IF ( IniReadInt ('error', iniDB, section = 'soil-balance') == 1) THEN IF ( .NOT. ALLOCATED (error % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'balance error not allocated, & forced to not export spatial average ') balanceout (10) = .FALSE. ELSE balanceout (10) = .TRUE. countbalance = countbalance + 1 END IF ELSE balanceout (10) = .FALSE. END IF balanceInitialized = .TRUE. CALL IniClose (iniDB) CALL ConfigureExtents (fileini, pathout) RETURN END SUBROUTINE InitSpatialAverageBalance !============================================================================== !| Description: ! Initialization of spatial average of snow variables SUBROUTINE InitSpatialAverageSnow & ! (fileini, pathout, rain, swe, meltCoeff, freeWater, snowMelt ) IMPLICIT NONE !arguments with intent in: CHARACTER(LEN = *), INTENT(IN) :: fileini CHARACTER(LEN = *), INTENT(IN) :: pathout TYPE (grid_real), INTENT(IN) :: rain !!rainfall rate (m/s) TYPE (grid_real), INTENT(IN) :: swe !!snow water equivalent (m) TYPE (grid_real), INTENT(IN) :: meltCoeff !!snow melt coefficient (mm/day/C) TYPE (grid_real), INTENT(IN) :: freeWater !! water in snow pack (m) TYPE (grid_real), INTENT(IN) :: snowMelt !!snow melt i the time step (m) !local declarations TYPE(IniList) :: iniDB !-------------------------------end of declaration----------------------------- ! open and read configuration file CALL IniOpen (fileini, iniDB) ! search for active variable for output CALL Catch ('info', 'SpatialAverage', 'checking for snow active variables ') countsnow = 0 !rainfall (liquid precipitation) IF ( IniReadInt ('rain', iniDB, section = 'snow') == 1) THEN IF ( .NOT. ALLOCATED (rain % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'liquid precipitation not allocated, & forced to not export spatial average ') snowout (1) = .FALSE. ELSE snowout (1) = .TRUE. countsnow = countsnow + 1 END IF ELSE snowout (1) = .FALSE. END IF !snow water equivalent IF ( IniReadInt ('snow-water-equivalent', iniDB, section = 'snow') == 1) THEN IF ( .NOT. ALLOCATED (swe % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'swe not allocated, & forced to not export spatial average ') snowout (2) = .FALSE. ELSE snowout (2) = .TRUE. countsnow = countsnow + 1 END IF ELSE snowout (2) = .FALSE. END IF !snow melt coefficient IF ( IniReadInt ('melt-coefficient', iniDB, section = 'snow') == 1) THEN IF ( .NOT. ALLOCATED (meltCoeff % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'melt-coefficient not allocated, & forced to not export spatial average ') snowout (3) = .FALSE. ELSE snowout (3) = .TRUE. countsnow = countsnow + 1 END IF ELSE snowout (3) = .FALSE. END IF !snow covered area IF ( IniReadInt ('snow-covered-area', iniDB, section = 'snow') == 1) THEN IF ( .NOT. ALLOCATED (swe % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'snow water equivalent not allocated, & forced to not export snow covered area ') snowout (4) = .FALSE. ELSE snowout (4) = .TRUE. countsnow = countsnow + 1 END IF ELSE snowout (4) = .FALSE. END IF !liquid water in snowpack IF ( IniReadInt ('water-in-snow', iniDB, section = 'snow') == 1) THEN IF ( .NOT. ALLOCATED (freeWater % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'water-in-snow not allocated, & forced to not export spatial average ') snowout (5) = .FALSE. ELSE snowout (5) = .TRUE. countsnow = countsnow + 1 END IF ELSE snowout (5) = .FALSE. END IF !snow melt IF ( IniReadInt ('snow-melt', iniDB, section = 'snow') == 1) THEN IF ( .NOT. ALLOCATED (snowMelt % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'snow-melt not allocated, & forced to not export spatial average ') snowout (6) = .FALSE. ELSE snowout (6) = .TRUE. countsnow = countsnow + 1 END IF ELSE snowout (6) = .FALSE. END IF snowInitialized = .TRUE. CALL IniClose (iniDB) CALL ConfigureExtents (fileini, pathout) RETURN END SUBROUTINE InitSpatialAverageSnow !============================================================================== !| Description: ! Initialization of spatial average of glaciers variables SUBROUTINE InitSpatialAverageGlaciers & ! (fileini, pathout, iwe, freeWater, iceMelt) IMPLICIT NONE !arguments with intent in: CHARACTER(LEN = *), INTENT(IN) :: fileini CHARACTER(LEN = *), INTENT(IN) :: pathout TYPE (grid_real), INTENT(IN) :: iwe !!ice water equivalent (m) TYPE (grid_real), INTENT(IN) :: freeWater !!water in ice (m) TYPE (grid_real), INTENT(IN) :: iceMelt !! ice melt in the time step (m) !local declarations TYPE(IniList) :: iniDB !-------------------------------end of declaration----------------------------- ! open and read configuration file CALL IniOpen (fileini, iniDB) ! search for active variable for output CALL Catch ('info', 'SpatialAverage', 'checking for glaciers active variables ') countice = 0 !ice water equivalent IF ( IniReadInt ('ice-water-equivalent', iniDB, section = 'glacier') == 1) THEN IF ( .NOT. ALLOCATED (iwe % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'ice water equivalent not allocated, & forced to not export spatial average ') iceout (1) = .FALSE. ELSE iceout (1) = .TRUE. countice = countice + 1 END IF ELSE iceout (1) = .FALSE. END IF !ice covered area IF ( IniReadInt ('ice-covered-area', iniDB, section = 'glacier') == 1) THEN IF ( .NOT. ALLOCATED (iwe % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'ice water equivalent not allocated, & forced to not export ice covered area ') iceout (2) = .FALSE. ELSE iceout (2) = .TRUE. countice = countice + 1 END IF ELSE iceout (2) = .FALSE. END IF !liquid water in ice IF ( IniReadInt ('water-in-ice', iniDB, section = 'glacier') == 1) THEN IF ( .NOT. ALLOCATED (freeWater % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'water-in-ice not allocated, & forced to not export water-in-ice ') iceout (3) = .FALSE. ELSE iceout (3) = .TRUE. countice = countice + 1 END IF ELSE iceout (3) = .FALSE. END IF !ice melt IF ( IniReadInt ('ice-melt', iniDB, section = 'glacier') == 1) THEN IF ( .NOT. ALLOCATED (iceMelt % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'ice-melt not allocated, & forced to not export spatial average ') iceout (4) = .FALSE. ELSE iceout (4) = .TRUE. countice = countice + 1 END IF ELSE iceout (4) = .FALSE. END IF iceInitialized = .TRUE. CALL IniClose (iniDB) CALL ConfigureExtents (fileini, pathout) RETURN END SUBROUTINE InitSpatialAverageGlaciers !============================================================================== !| Description: ! Initialization of spatial average of sediment variables SUBROUTINE InitSpatialAverageSediment & ! (fileini, pathout, detrate) IMPLICIT NONE !arguments with intent in: CHARACTER(LEN = *), INTENT(IN) :: fileini CHARACTER(LEN = *), INTENT(IN) :: pathout TYPE (grid_real), INTENT(IN) :: detrate !!sediment detachment rate (kg/s) !local declarations TYPE(IniList) :: iniDB !-------------------------------end of declaration----------------------------- ! open and read configuration file CALL IniOpen (fileini, iniDB) ! search for active variable for output CALL Catch ('info', 'SpatialAverage', 'checking for sediment active variables ') countsediment = 0 !detachment rate IF ( IniReadInt ('detachment-rate', iniDB, section = 'sediment') == 1) THEN IF ( .NOT. ALLOCATED (detrate % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'detachment rate not allocated, & forced to not export spatial average ') sedimentout (1) = .FALSE. ELSE sedimentout (1) = .TRUE. countsediment = countsediment + 1 END IF ELSE sedimentout (1) = .FALSE. END IF sedimentInitialized = .TRUE. CALL IniClose (iniDB) CALL ConfigureExtents (fileini, pathout) RETURN END SUBROUTINE InitSpatialAverageSediment !============================================================================== !| Description: ! Initialization of spatial average of canopy interception variables SUBROUTINE InitSpatialAverageCanopy & ! (fileini, pathout, canopyStorage, throughfall, pt) IMPLICIT NONE !arguments with intent in: CHARACTER(LEN = *), INTENT(IN) :: fileini CHARACTER(LEN = *), INTENT(IN) :: pathout TYPE (grid_real), INTENT(IN) :: canopyStorage !!water canopy storage (mm) TYPE (grid_real), INTENT(IN) :: throughfall !! effective rain reaching soil surface (m/s) TYPE (grid_real), INTENT(IN) :: pt!! potential transpiration from canopy (m/s) !local declarations TYPE(IniList) :: iniDB !-------------------------------end of declaration----------------------------- ! open and read configuration file CALL IniOpen (fileini, iniDB) ! search for active variable for output CALL Catch ('info', 'SpatialAverage', 'checking for canopy active variables ') countcanopy = 0 !canopy storage IF ( IniReadInt ('canopy-storage', iniDB, section = 'canopy') == 1) THEN IF ( .NOT. ALLOCATED (canopyStorage % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'canopy storage not allocated, & forced to not export spatial average ') canopyout (1) = .FALSE. ELSE canopyout (1) = .TRUE. countcanopy = countcanopy + 1 END IF ELSE canopyout (1) = .FALSE. END IF !throughfall IF ( IniReadInt ('throughfall', iniDB, section = 'canopy') == 1) THEN IF ( .NOT. ALLOCATED (throughfall % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'throughfall not allocated, & forced to not export spatial average ') canopyout (2) = .FALSE. ELSE canopyout (2) = .TRUE. countcanopy = countcanopy + 1 END IF ELSE canopyout (2) = .FALSE. END IF !canopy evaporation IF ( IniReadInt ('transpiration', iniDB, section = 'canopy') == 1) THEN IF ( .NOT. ALLOCATED (pt % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'transpiration not allocated, & forced to not export spatial average ') canopyout (3) = .FALSE. ELSE canopyout (3) = .TRUE. countcanopy = countcanopy + 1 END IF ELSE canopyout (3) = .FALSE. END IF canopyInitialized = .TRUE. CALL IniClose (iniDB) CALL ConfigureExtents (fileini, pathout) RETURN END SUBROUTINE InitSpatialAverageCanopy !============================================================================== !| Description: ! Initialization of spatial average of plants dynamic variables SUBROUTINE InitSpatialAveragePlants & ! (fileini, pathout, lai, gpp, npp, stem, root, leaf, cover, dbh, height, & density, stemyield) IMPLICIT NONE !arguments with intent in: CHARACTER(LEN = *), INTENT(IN) :: fileini CHARACTER(LEN = *), INTENT(IN) :: pathout TYPE (grid_real), INTENT(IN) :: lai !!leaf area index (m2/m2) TYPE (grid_real), INTENT(IN) :: gpp !!gross primary production (t) TYPE (grid_real), INTENT(IN) :: npp !!net primary production (t) TYPE (grid_real), INTENT(IN) :: stem !!stem biomass (t) TYPE (grid_real), INTENT(IN) :: root !!root biomass (t) TYPE (grid_real), INTENT(IN) :: leaf !!foliage biomass (t) TYPE (grid_real), INTENT(IN) :: cover !!canopy cover (0-1) TYPE (grid_real), INTENT(IN) :: dbh !!diameter at brest heigth (cm) TYPE (grid_real), INTENT(IN) :: height !!tree height (m) TYPE (grid_real), INTENT(IN) :: density !!tree density (tree/hectare) TYPE (grid_real), INTENT(IN) :: stemyield !!stem yield (t) !local declarations TYPE(IniList) :: iniDB !-------------------------------end of declaration----------------------------- ! open and read configuration file CALL IniOpen (fileini, iniDB) ! search for active variable for output CALL Catch ('info', 'SpatialAverage', 'checking for plants active variables ') countplants = 0 !leaf area index IF ( IniReadInt ('lai', iniDB, section = 'plants') == 1) THEN IF ( .NOT. ALLOCATED (lai % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'lai not allocated, & forced to not export spatial average ') plantsout (1) = .FALSE. ELSE plantsout (1) = .TRUE. countplants = countplants + 1 END IF ELSE plantsout (1) = .FALSE. END IF !gross primary production IF ( IniReadInt ('gpp', iniDB, section = 'plants') == 1) THEN IF ( .NOT. ALLOCATED (gpp % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'gpp not allocated, & forced to not export spatial average ') plantsout (2) = .FALSE. ELSE plantsout (2) = .TRUE. countplants = countplants + 1 END IF ELSE plantsout (2) = .FALSE. END IF !net primary priduction IF ( IniReadInt ('npp', iniDB, section = 'plants') == 1) THEN IF ( .NOT. ALLOCATED (npp % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'npp not allocated, & forced to not export spatial average ') plantsout (3) = .FALSE. ELSE plantsout (3) = .TRUE. countplants = countplants + 1 END IF ELSE plantsout (3) = .FALSE. END IF !stem biomass IF ( IniReadInt ('stem', iniDB, section = 'plants') == 1) THEN IF ( .NOT. ALLOCATED (stem % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'stem biomass not allocated, & forced to not export spatial average ') plantsout (4) = .FALSE. ELSE plantsout (4) = .TRUE. countplants = countplants + 1 END IF ELSE plantsout (4) = .FALSE. END IF !root biomass IF ( IniReadInt ('root', iniDB, section = 'plants') == 1) THEN IF ( .NOT. ALLOCATED (root % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'root biomass not allocated, & forced to not export spatial average ') plantsout (5) = .FALSE. ELSE plantsout (5) = .TRUE. countplants = countplants + 1 END IF ELSE plantsout (5) = .FALSE. END IF !leaf biomass IF ( IniReadInt ('leaf', iniDB, section = 'plants') == 1) THEN IF ( .NOT. ALLOCATED (leaf % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'leaf biomass not allocated, & forced to not export spatial average ') plantsout (6) = .FALSE. ELSE plantsout (6) = .TRUE. countplants = countplants + 1 END IF ELSE plantsout (6) = .FALSE. END IF !canopy cover IF ( IniReadInt ('cover', iniDB, section = 'plants') == 1) THEN IF ( .NOT. ALLOCATED (cover % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'canopy cover not allocated, & forced to not export spatial average ') plantsout (7) = .FALSE. ELSE plantsout (7) = .TRUE. countplants = countplants + 1 END IF ELSE plantsout (7) = .FALSE. END IF !diameter at brest heigth IF ( IniReadInt ('dbh', iniDB, section = 'plants') == 1) THEN IF ( .NOT. ALLOCATED (dbh % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'dbh not allocated, & forced to not export spatial average ') plantsout (8) = .FALSE. ELSE plantsout (8) = .TRUE. countplants = countplants + 1 END IF ELSE plantsout (8) = .FALSE. END IF !tree height IF ( IniReadInt ('height', iniDB, section = 'plants') == 1) THEN IF ( .NOT. ALLOCATED (height % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'height not allocated, & forced to not export spatial average ') plantsout (9) = .FALSE. ELSE plantsout (9) = .TRUE. countplants = countplants + 1 END IF ELSE plantsout (9) = .FALSE. END IF !tree density IF ( IniReadInt ('density', iniDB, section = 'plants') == 1) THEN IF ( .NOT. ALLOCATED (density % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'density not allocated, & forced to not export spatial average ') plantsout (10) = .FALSE. ELSE plantsout (10) = .TRUE. countplants = countplants + 1 END IF ELSE plantsout (10) = .FALSE. END IF !stem yield IF ( IniReadInt ('stem-yield', iniDB, section = 'plants') == 1) THEN IF ( .NOT. ALLOCATED (stemyield % mat) ) THEN CALL Catch ('warning', 'SpatialAverage', 'stem yield not allocated, & forced to not export spatial average ') plantsout (11) = .FALSE. ELSE plantsout (11) = .TRUE. countplants = countplants + 1 END IF ELSE plantsout (11) = .FALSE. END IF plantsInitialized = .TRUE. CALL IniClose (iniDB) CALL ConfigureExtents (fileini, pathout) RETURN END SUBROUTINE InitSpatialAveragePlants !============================================================================== !| Description: ! Configure extents for computing and storing spatial average values SUBROUTINE ConfigureExtents & ! (fileini, pathout) IMPLICIT NONE !arguments with intent in: CHARACTER(LEN = *), INTENT(IN) :: fileini CHARACTER(LEN = *), INTENT(IN) :: pathout !local declarations TYPE(IniList) :: iniDB INTEGER (KIND = short) :: i, r, c CHARACTER (LEN = 300) :: maskfile CHARACTER (LEN = 300) :: filename !-------------------------------end of declaration----------------------------- IF ( .NOT. ( meteoInitialized .AND. & balanceInitialized .AND. & snowInitialized .AND. & iceInitialized .AND. & sedimentInitialized .AND. & canopyInitialized .AND. & plantsInitialized ) ) THEN !initialization still not finished RETURN END IF CALL Catch ('info', 'SpatialAverage', 'Configuring extents ') ! open and read configuration file CALL IniOpen (fileini, iniDB) !configure extents CALL Catch ('info', 'SpatialAverage', 'configuring extents ') CALL TableNew (fileini, extent_table) nextents = TableGetNrows (extent_table) ALLOCATE (extents(nextents)) DO i = 1, nextents !read id CALL TableGetValue ( REAL(i), extent_table, 'count', 'id', extents (i) % id) !read name CALL TableGetValue ( REAL(i), extent_table, 'count', 'name', extents (i) % name) !read mask CALL TableGetValue ( REAL(i), extent_table, 'count', 'file', maskfile) CALL NewGrid (extents (i) % mask, maskfile, ESRI_ASCII) extents (i) % mask % grid_mapping = DecodeEPSG ( IniReadInt ('epsg', iniDB)) !compute surface area extents (i) % area = 0. DO r = 1, extents (i) % mask % idim DO c = 1, extents (i) % mask % jdim IF (extents (i) % mask % mat (r,c) /= extents (i) % mask % nodata) THEN extents (i) % area = extents (i) % area + & CellArea (extents (i) % mask, r, c) END IF END DO END DO IF (countmeteo > 0) THEN ALLOCATE ( extents (i) % meteo (countmeteo)) filename = TRIM(pathout) // TRIM(extents (i) % name) // '_meteo.out' extents (i) % filemeteo = filename END IF IF (countbalance > 0) THEN ALLOCATE ( extents (i) % balance (countbalance)) filename = TRIM(pathout) // TRIM(extents (i) % name) // '_balance.out' extents (i) % filebalance = filename END IF IF (countsnow > 0) THEN ALLOCATE ( extents (i) % snow (countsnow)) filename = TRIM(pathout) // TRIM(extents (i) % name) // '_snow.out' extents (i) % filesnow = filename END IF IF (countice > 0) THEN ALLOCATE ( extents (i) % ice (countice)) filename = TRIM(pathout) // TRIM(extents (i) % name) // '_glaciers.out' extents (i) % fileice = filename END IF IF (countsediment > 0) THEN ALLOCATE ( extents (i) % sediment (countsediment)) filename = TRIM(pathout) // TRIM(extents (i) % name) // '_sediment.out' extents (i) % filesediment = filename END IF IF (countcanopy > 0) THEN ALLOCATE ( extents (i) % canopy (countcanopy)) filename = TRIM(pathout) // TRIM(extents (i) % name) // '_canopy.out' extents (i) % filecanopy = filename END IF IF (countplants > 0) THEN ALLOCATE ( extents (i) % plants (countplants)) filename = TRIM(pathout) // TRIM(extents (i) % name) // '_plants.out' extents (i) % fileplants = filename END IF END DO CALL IniClose (iniDB) RETURN END SUBROUTINE ConfigureExtents !============================================================================== !| Description: ! Compute spatial average of meteorological variables SUBROUTINE ComputeSpatialAverageMeteo & ! (dt, temp, tmean, tmax, tmin, precipitation, rh, radiation, netradiation, & windspeed, daily_precipitation, irrigation) IMPLICIT NONE !arguments with intent in: INTEGER (KIND = short), INTENT(IN) :: dt !!time step (s) TYPE (grid_real), INTENT(IN) :: temp !!air temperarure (°C) TYPE (grid_real), INTENT(IN) :: tmean !!air temperarure daily mean(°C) TYPE (grid_real), INTENT(IN) :: tmax !!air temperarure daily max (°C) TYPE (grid_real), INTENT(IN) :: tmin !!air temperarure daily min (°C) TYPE (grid_real), INTENT(IN) :: precipitation !!precipitation rate (m/s) TYPE (grid_real), INTENT(IN) :: rh !!air relative humidity (0-100) TYPE (grid_real), INTENT(IN) :: radiation !!solar radiation (w/m2) TYPE (grid_real), INTENT(IN) :: netradiation !!net radiation (w/m2) TYPE (grid_real), INTENT(IN) :: windspeed !!wind speed (m/s) TYPE (grid_real), INTENT(IN) :: daily_precipitation !!daily precipitation (m/s) TYPE (grid_real), INTENT(IN) :: irrigation !!irrigation rate (m/s) !local declarations INTEGER (KIND = short) :: i INTEGER (KIND = short) :: count !-------------------------------end of declaration----------------------------- DO i = 1, nextents count = 0 !precipitation IF ( meteoout (1) ) THEN count = count + 1 extents (i) % meteo (count) = & GetMean (precipitation, maskInteger = extents (i) % mask ) * & dt * 1000. !conversion to mm over dt END IF !daily precipitation IF ( meteoout (2) ) THEN count = count + 1 extents (i) % meteo (count) = & GetMean (daily_precipitation, maskInteger = extents (i) % mask ) * & dt * 1000. !conversion to mm over dt END IF !temperature IF ( meteoout (3) ) THEN count = count + 1 extents (i) % meteo (count) = & GetMean (temp, maskInteger = extents (i) % mask ) END IF !temperature daily mean IF ( meteoout (4) ) THEN count = count + 1 extents (i) % meteo (count) = & GetMean (tmean, maskInteger = extents (i) % mask ) END IF !temperature daily max IF ( meteoout (5) ) THEN count = count + 1 extents (i) % meteo (count) = & GetMean (tmax, maskInteger = extents (i) % mask ) END IF !temperature daily min IF ( meteoout (6) ) THEN count = count + 1 extents (i) % meteo (count) = & GetMean (tmin, maskInteger = extents (i) % mask ) END IF !relative humidity IF ( meteoout (7) ) THEN count = count + 1 extents (i) % meteo (count) = & GetMean (rh, maskInteger = extents (i) % mask ) END IF !radiation IF ( meteoout (8) ) THEN count = count + 1 extents (i) % meteo (count) = & GetMean (radiation, maskInteger = extents (i) % mask ) END IF !net radiation IF ( meteoout (9) ) THEN count = count + 1 extents (i) % meteo (count) = & GetMean (netradiation, maskInteger = extents (i) % mask ) END IF !windspeed IF ( meteoout (10) ) THEN count = count + 1 extents (i) % meteo (count) = & GetMean (windspeed, maskInteger = extents (i) % mask ) END IF !irrigation IF ( meteoout (11) ) THEN count = count + 1 extents (i) % meteo (count) = & GetMean (irrigation, maskInteger = extents (i) % mask ) * & dt * 1000. !conversion to mm over dt END IF END DO RETURN END SUBROUTINE ComputeSpatialAverageMeteo !============================================================================== !| Description: ! Compute spatial average of soil water balance variables SUBROUTINE ComputeSpatialAverageBalance & ! (dt, sm, smrz, smtz, runoff, infrate, perc, et, pet, caprise, error) IMPLICIT NONE !arguments with intent in: INTEGER (KIND = short), INTENT(IN) :: dt !!time step (s) TYPE (grid_real), INTENT(IN) :: sm !!mean soil moisture (m3/m3) TYPE (grid_real), INTENT(IN) :: smrz !!root zone soil moisture (m3/m3) TYPE (grid_real), INTENT(IN) :: smtz !!transmission zone soil moisture (m3/m3) TYPE (grid_real), INTENT(IN) :: runoff !!runoff rate (m/s) TYPE (grid_real), INTENT(IN) :: infrate !!infiltration rate (m/s) TYPE (grid_real), INTENT(IN) :: perc !!percolation (m/s) TYPE (grid_real), INTENT(IN) :: et !!actual evapotranspiration rate (m/s) TYPE (grid_real), INTENT(IN) :: pet !!potential evapotranspiration rate (m/s) TYPE (grid_real), INTENT(IN) :: caprise !!actual evapotranspiration rate (m/s) TYPE (grid_real), INTENT(IN) :: error !! balance error (mm) !local declarations INTEGER (KIND = short) :: i INTEGER (KIND = short) :: count !-------------------------------end of declaration----------------------------- DO i = 1, nextents count = 0 !mean soil moisture IF ( balanceout (1) ) THEN count = count + 1 extents (i) % balance (count) = & GetMean (sm, maskInteger = extents (i) % mask ) END IF !root zone soil moisture IF ( balanceout (2) ) THEN count = count + 1 extents (i) % balance (count) = & GetMean (smrz, maskInteger = extents (i) % mask ) END IF !transmission zone soil moisture IF ( balanceout (3) ) THEN count = count + 1 extents (i) % balance (count) = & GetMean (smtz, maskInteger = extents (i) % mask ) END IF !runoff IF ( balanceout (4) ) THEN count = count + 1 extents (i) % balance (count) = & GetMean (runoff, maskInteger = extents (i) % mask ) * & dt * 1000. !conversion to mm over dt END IF !infiltration IF ( balanceout (5) ) THEN count = count + 1 extents (i) % balance (count) = & GetMean (infrate, maskInteger = extents (i) % mask ) * & dt * 1000. !conversion to mm over dt END IF !percolation IF ( balanceout (6) ) THEN count = count + 1 extents (i) % balance (count) = & GetMean (perc, maskInteger = extents (i) % mask ) * & dt * 1000. !conversion to mm over dt END IF !actual evapotranspiration IF ( balanceout (7) ) THEN count = count + 1 extents (i) % balance (count) = & GetMean (et, maskInteger = extents (i) % mask ) * & dt * 1000. !conversion to mm over dt END IF !potential evapotranspiration IF ( balanceout (8) ) THEN count = count + 1 extents (i) % balance (count) = & GetMean (pet, maskInteger = extents (i) % mask ) * & dt * 1000. !conversion to mm over dt END IF !capillary rise IF ( balanceout (9) ) THEN count = count + 1 extents (i) % balance (count) = & GetMean (caprise, maskInteger = extents (i) % mask ) * & dt * 1000. !conversion to mm over dt END IF !balance error IF ( balanceout (10) ) THEN count = count + 1 extents (i) % balance (count) = & GetMean (error, maskInteger = extents (i) % mask ) END IF END DO RETURN END SUBROUTINE ComputeSpatialAverageBalance !============================================================================== !| Description: ! Compute spatial average of snow variables SUBROUTINE ComputeSpatialAverageSnow & ! (dt, rain, swe, meltCoeff, freeWater, snowMelt) IMPLICIT NONE !arguments with intent in: INTEGER (KIND = short), INTENT(IN) :: dt !!time step (s) TYPE (grid_real), INTENT(IN) :: rain !! liquid precipitation rate (m/s) TYPE (grid_real), INTENT(IN) :: swe !! snow water equivalent (m) TYPE (grid_real), INTENT(IN) :: meltCoeff !! melt coefficient (mm/day/°C) TYPE (grid_real), INTENT(IN) :: freeWater !! liquid water in snow (m) TYPE (grid_real), INTENT(IN) :: snowMelt !!snow melt (m) !DEBUG intent(inout) to let modify grid_mapping !local declarations INTEGER (KIND = short) :: i, r, c INTEGER (KIND = short) :: count REAL (KIND = float) :: snowarea ![m2] !-------------------------------end of declaration----------------------------- !DEBUG !force gridmapping on snow maps !remeber to remove it after new release of snow module will be !developed that sets CRS properly !swe % grid_mapping = rain % grid_mapping !water % grid_mapping = rain % grid_mapping DO i = 1, nextents count = 0 !rainfall (precipitation liquid fraction) IF ( snowout (1) ) THEN count = count + 1 extents (i) % snow (count) = & GetMean (rain, maskInteger = extents (i) % mask ) * & dt * 1000. !conversion to mm over dt END IF !snow water equivalent IF ( snowout (2) ) THEN count = count + 1 extents (i) % snow (count) = & GetMean (swe, maskInteger = extents (i) % mask ) * 1000. END IF !snow melt coefficient IF ( snowout (3) ) THEN count = count + 1 extents (i) % snow (count) = & GetMean (meltCoeff, maskInteger = extents (i) % mask ) END IF !snow covered percentage IF ( snowout (4) ) THEN !compute snow covered area snowarea = 0. DO r = 1, extents (i) % mask % idim DO c = 1, extents (i) % mask % jdim IF (extents (i) % mask % mat (r,c) /= extents (i) % mask % nodata) THEN IF (swe % mat (r,c) > 0.) THEN snowarea = snowarea + CellArea (extents (i) % mask, r, c) END IF END IF END DO END DO !compute snow covered percentage count = count + 1 extents (i) % snow (count) = snowarea / extents (i) % area END IF !water in snow IF ( snowout (5) ) THEN count = count + 1 extents (i) % snow (count) = & GetMean (freeWater, maskInteger = extents (i) % mask ) * 1000. END IF !snow melt IF ( snowout (6) ) THEN count = count + 1 extents (i) % snow (count) = & GetMean (snowMelt, maskInteger = extents (i) % mask ) * 1000. END IF END DO RETURN END SUBROUTINE ComputeSpatialAverageSnow !============================================================================== !| Description: ! Compute spatial average of glaciers variables SUBROUTINE ComputeSpatialAverageGlaciers & ! (dt, iwe, water, iceMelt) IMPLICIT NONE !arguments with intent in: INTEGER (KIND = short), INTENT(IN) :: dt !!time step (s) TYPE (grid_real), INTENT(IN) :: iwe !! ice water equivalent (m) TYPE (grid_real), INTENT(INOUT) :: water !! free water in ice (m) TYPE (grid_real), INTENT(IN) :: iceMelt !! ice melt in the time step (m) !local declarations INTEGER (KIND = short) :: i, r, c INTEGER (KIND = short) :: count REAL (KIND = float) :: icearea ![m2] !-------------------------------end of declaration----------------------------- DO i = 1, nextents count = 0 !ice water equivalent IF ( iceout (1) ) THEN count = count + 1 extents (i) % ice (count) = & GetMean (iwe, maskInteger = extents (i) % mask ) * 1000. END IF !glacier covered percentage IF ( iceout (2) ) THEN !compute glacier covered area icearea = 0. DO r = 1, extents (i) % mask % idim DO c = 1, extents (i) % mask % jdim IF (extents (i) % mask % mat (r,c) /= extents (i) % mask % nodata) THEN IF (iwe % mat (r,c) > 0.) THEN icearea = icearea + CellArea (extents (i) % mask, r, c) END IF END IF END DO END DO !compute snow covered percentage count = count + 1 extents (i) % ice (count) = icearea / extents (i) % area END IF !free water in ice pack IF ( iceout (3) ) THEN count = count + 1 extents (i) % ice (count) = & GetMean (water, maskInteger = extents (i) % mask ) * 1000. END IF !ice melt IF ( iceout (4) ) THEN count = count + 1 extents (i) % ice (count) = & GetMean (iceMelt, maskInteger = extents (i) % mask ) * 1000. END IF END DO RETURN END SUBROUTINE ComputeSpatialAverageGlaciers !============================================================================== !| Description: ! Compute spatial average of sediment variables SUBROUTINE ComputeSpatialAverageSediment & ! (dt, erosion) IMPLICIT NONE !arguments with intent in: INTEGER (KIND = short), INTENT(IN) :: dt !!time step (s) TYPE (grid_real), INTENT(IN) :: erosion !! interril sediment detachment rate (kg/s) !local declarations INTEGER (KIND = short) :: i, r, c INTEGER (KIND = short) :: count REAL (KIND = float) :: icearea ![m2] !-------------------------------end of declaration----------------------------- DO i = 1, nextents count = 0 !erosion (interril sediment detachment) IF ( sedimentout (1) ) THEN count = count + 1 extents (i) % sediment (count) = & GetMean (erosion, maskInteger = extents (i) % mask ) * dt !conversion to kg over dt END IF END DO RETURN END SUBROUTINE ComputeSpatialAverageSediment !============================================================================== !| Description: ! Compute spatial average of canopy interception variables SUBROUTINE ComputeSpatialAverageCanopy & ! (dt, canopyStorage, throughfall, pt) IMPLICIT NONE !arguments with intent in: INTEGER (KIND = short), INTENT(IN) :: dt !!time step (s) TYPE (grid_real), INTENT(IN) :: canopyStorage !!water canopy storage (mm) TYPE (grid_real), INTENT(IN) :: throughfall !! effective rain reaching soil surface (m/s) TYPE (grid_real), INTENT(IN) :: pt!! potential transpiration from canopy (m/s) !local declarations INTEGER (KIND = short) :: i INTEGER (KIND = short) :: count !-------------------------------end of declaration----------------------------- DO i = 1, nextents count = 0 !canopy storage IF ( canopyout (1) ) THEN count = count + 1 extents (i) % canopy (count) = & GetMean (canopyStorage, maskInteger = extents (i) % mask ) END IF !throughfall IF ( canopyout (2) ) THEN count = count + 1 extents (i) % canopy (count) = & GetMean (throughfall, maskInteger = extents (i) % mask ) * & dt * 1000. !conversion to mm over dt END IF !transpiration (evaporation from canopy) IF ( canopyout (3) ) THEN count = count + 1 extents (i) % canopy (count) = & GetMean (pt, maskInteger = extents (i) % mask ) * & dt * 1000. !conversion to mm over dt END IF END DO RETURN END SUBROUTINE ComputeSpatialAverageCanopy !============================================================================== !| Description: ! Compute spatial average of plants variables SUBROUTINE ComputeSpatialAveragePlants & ! (dt, lai, gpp, npp, stem, root, leaf, cover, dbh, height, density, stemyield) IMPLICIT NONE !arguments with intent in: INTEGER (KIND = short), INTENT(IN) :: dt !!time step (s) TYPE (grid_real), INTENT(IN) :: lai !!leaf area index (m2/m2) TYPE (grid_real), INTENT(IN) :: gpp !!gross primary production (t) TYPE (grid_real), INTENT(IN) :: npp !!net primary production (t) TYPE (grid_real), INTENT(IN) :: stem !!stem biomass (t) TYPE (grid_real), INTENT(IN) :: root !!root biomass (t) TYPE (grid_real), INTENT(IN) :: leaf !!foliage biomass (t) TYPE (grid_real), INTENT(IN) :: cover !!canopy cover (0-1) TYPE (grid_real), INTENT(IN) :: dbh !!diameter at brest heigth (cm) TYPE (grid_real), INTENT(IN) :: height !!tree height (m) TYPE (grid_real), INTENT(IN) :: density !!tree density (tree/hectare) TYPE (grid_real), INTENT(IN) :: stemyield !!stem yield (t) !local declarations INTEGER (KIND = short) :: i INTEGER (KIND = short) :: count !-------------------------------end of declaration----------------------------- DO i = 1, nextents count = 0 !leaf area index IF ( plantsout (1) ) THEN count = count + 1 extents (i) % plants (count) = & GetMean (lai, maskInteger = extents (i) % mask ) END IF !gross primary production IF ( plantsout (2) ) THEN count = count + 1 extents (i) % plants (count) = & GetSum (gpp, maskInteger = extents (i) % mask ) END IF !net primary production IF ( plantsout (3) ) THEN count = count + 1 extents (i) % plants (count) = & GetSum (npp, maskInteger = extents (i) % mask ) END IF !stem biomass IF ( plantsout (4) ) THEN count = count + 1 extents (i) % plants (count) = & GetSum (stem, maskInteger = extents (i) % mask ) END IF !root biomass IF ( plantsout (5) ) THEN count = count + 1 extents (i) % plants (count) = & GetSum (root, maskInteger = extents (i) % mask ) END IF !leaf biomass IF ( plantsout (6) ) THEN count = count + 1 extents (i) % plants (count) = & GetSum (leaf, maskInteger = extents (i) % mask ) END IF !canopy cover IF ( plantsout (7) ) THEN count = count + 1 extents (i) % plants (count) = & GetMean (cover, maskInteger = extents (i) % mask ) END IF !diameter at brest height IF ( plantsout (8) ) THEN count = count + 1 extents (i) % plants (count) = & GetMean (dbh, maskInteger = extents (i) % mask ) END IF !tree height (m) IF ( plantsout (9) ) THEN count = count + 1 extents (i) % plants (count) = & GetMean (height, maskInteger = extents (i) % mask ) END IF !tree density (tree/hectare) IF ( plantsout (10) ) THEN count = count + 1 extents (i) % plants (count) = & GetMean (density, maskInteger = extents (i) % mask ) END IF !stem yield IF ( plantsout (11) ) THEN count = count + 1 extents (i) % plants (count) = & GetSum (stemyield, maskInteger = extents (i) % mask ) END IF END DO RETURN END SUBROUTINE ComputeSpatialAveragePlants !============================================================================== !| Description: ! Export spatial average of meteorological variables SUBROUTINE ExportSpatialAverageMeteo & ! (init) IMPLICIT NONE !arguments with intent in: LOGICAL, OPTIONAL, INTENT(IN) :: init !local declarations INTEGER (KIND = short) :: i, k, count !-------------------------------end of declaration----------------------------- IF ( countmeteo == 0 ) THEN RETURN END IF IF (PRESENT (init) .AND. init ) THEN ! open file and write header DO i = 1, nextents extents (i) % unitmeteo = GetUnit () OPEN (UNIT = extents (i) % unitmeteo, FILE = extents (i) % filemeteo) WRITE(UNIT = extents (i) % unitmeteo, FMT ='(a)') & 'spatial average values of meteorological variables' WRITE(UNIT = extents (i) % unitmeteo, FMT ='(a,a)') & 'extent id: ', TRIM(extents (i) % id) WRITE(UNIT = extents (i) % unitmeteo, FMT ='(a,a)') & 'extent name: ', TRIM(extents (i) % name) WRITE(UNIT = extents (i) % unitmeteo, FMT ='(a,f15.5)') & 'extent area (km2): ', extents (i) % area / 1000. ** 2. WRITE(UNIT = extents (i) % unitmeteo, FMT ='(a,i5)') & 'number of variables: ', countmeteo WRITE(UNIT = extents (i) % unitmeteo, FMT = *) WRITE(UNIT = extents (i) % unitmeteo, FMT = '(a)') 'data' WRITE(UNIT = extents (i) % unitmeteo, FMT = '(a)', ADVANCE = 'no' ) 'DateTime ' count = 0 DO k = 1, SIZE (meteoout) IF (meteoout (k) ) THEN count = count + 1 IF (count == countmeteo) THEN !last header WRITE(UNIT = extents (i) % unitmeteo, FMT = '(a)') TRIM(meteoheader (k)) ELSE WRITE(UNIT = extents (i) % unitmeteo, FMT = '(a,2x)', ADVANCE = 'no') TRIM(meteoheader (k)) END IF END IF END DO END DO ELSE !write spatial average values timeString = timeSpatialAverageMeteo DO i = 1, nextents WRITE(UNIT = extents (i) % unitmeteo, FMT ='(a,2x, 11(E12.5,5x))') & timeString, (extents (i) % meteo (k), k = 1, countmeteo) END DO END IF RETURN END SUBROUTINE ExportSpatialAverageMeteo !============================================================================== !| Description: ! Export spatial average of soil balance variables SUBROUTINE ExportSpatialAverageBalance & ! (init) IMPLICIT NONE !arguments with intent in: LOGICAL, OPTIONAL, INTENT(IN) :: init !local declarations INTEGER (KIND = short) :: i, k, count !-------------------------------end of declaration----------------------------- IF ( countbalance == 0 ) THEN RETURN END IF IF (PRESENT (init) .AND. init ) THEN !open file and write header DO i = 1, nextents extents (i) % unitbalance = GetUnit () OPEN (UNIT = extents (i) % unitbalance, FILE = extents (i) % filebalance) WRITE(UNIT = extents (i) % unitbalance, FMT ='(a)') & 'spatial average values of soil balance variables' WRITE(UNIT = extents (i) % unitbalance, FMT ='(a,a)') & 'extent id: ', TRIM(extents (i) % id) WRITE(UNIT = extents (i) % unitbalance, FMT ='(a,a)') & 'extent name: ', TRIM(extents (i) % name) WRITE(UNIT = extents (i) % unitbalance, FMT ='(a,f15.5)') & 'extent area (km2): ', extents (i) % area / 1000. ** 2. WRITE(UNIT = extents (i) % unitbalance, FMT ='(a,i5)') & 'number of variables: ', countbalance WRITE(UNIT = extents (i) % unitbalance, FMT = *) WRITE(UNIT = extents (i) % unitbalance, FMT = '(a)') 'data' WRITE(UNIT = extents (i) % unitbalance, FMT = '(a)', ADVANCE = 'no' ) 'DateTime ' count = 0 DO k = 1, SIZE (balanceout) IF (balanceout (k) ) THEN count = count + 1 IF (count == countbalance) THEN !last header WRITE(UNIT = extents (i) % unitbalance, FMT = '(a)') TRIM(balanceheader (k)) ELSE WRITE(UNIT = extents (i) % unitbalance, FMT = '(a,2x)', ADVANCE = 'no') & TRIM(balanceheader (k)) END IF END IF END DO END DO ELSE !write spatial average values timeString = timeSpatialAverageBalance DO i = 1, nextents WRITE(UNIT = extents (i) % unitbalance, FMT ='(a,2x, 10(E12.5,5x))') & timeString, (extents (i) % balance (k), k = 1, countbalance) END DO END IF RETURN END SUBROUTINE ExportSpatialAverageBalance !============================================================================== !| Description: ! Export spatial average of snow variables SUBROUTINE ExportSpatialAverageSnow & ! (init) IMPLICIT NONE !arguments with intent in: LOGICAL, OPTIONAL, INTENT(IN) :: init !local declarations INTEGER (KIND = short) :: i, k, count !-------------------------------end of declaration----------------------------- IF ( countsnow == 0 ) THEN RETURN END IF IF (PRESENT (init) .AND. init ) THEN !open file and write header DO i = 1, nextents extents (i) % unitsnow = GetUnit () OPEN (UNIT = extents (i) % unitsnow, FILE = extents (i) % filesnow) WRITE(UNIT = extents (i) % unitsnow, FMT ='(a)') & 'spatial average values of snow variables' WRITE(UNIT = extents (i) % unitsnow, FMT ='(a,a)') & 'extent id: ', TRIM(extents (i) % id) WRITE(UNIT = extents (i) % unitsnow, FMT ='(a,a)') & 'extent name: ', TRIM(extents (i) % name) WRITE(UNIT = extents (i) % unitsnow, FMT ='(a,f15.5)') & 'extent area (km2): ', extents (i) % area / 1000. ** 2. WRITE(UNIT = extents (i) % unitsnow, FMT ='(a,i5)') & 'number of variables: ', countsnow WRITE(UNIT = extents (i) % unitsnow, FMT = *) WRITE(UNIT = extents (i) % unitsnow, FMT = '(a)') 'data' WRITE(UNIT = extents (i) % unitsnow, FMT = '(a)', ADVANCE = 'no' ) 'DateTime ' count = 0 DO k = 1, SIZE (snowout) IF (snowout (k) ) THEN count = count + 1 IF (count == countsnow) THEN !last header WRITE(UNIT = extents (i) % unitsnow, FMT = '(a)') TRIM(snowheader (k)) ELSE WRITE(UNIT = extents (i) % unitsnow, FMT = '(a,2x)', ADVANCE = 'no') & TRIM(snowheader (k)) END IF END IF END DO END DO ELSE !write spatial average values timeString = timeSpatialAverageSnow DO i = 1, nextents WRITE(UNIT = extents (i) % unitsnow, FMT ='(a,2x, 10(E12.5,5x))') & timeString, (extents (i) % snow (k), k = 1, countsnow) END DO END IF RETURN END SUBROUTINE ExportSpatialAverageSnow !============================================================================== !| Description: ! Export spatial average of glaciers variables SUBROUTINE ExportSpatialAverageGlaciers & ! (init) IMPLICIT NONE !arguments with intent in: LOGICAL, OPTIONAL, INTENT(IN) :: init !local declarations INTEGER (KIND = short) :: i, k, count !-------------------------------end of declaration----------------------------- IF ( countice == 0 ) THEN RETURN END IF IF (PRESENT (init) .AND. init ) THEN !open file and write header DO i = 1, nextents extents (i) % unitice = GetUnit () OPEN (UNIT = extents (i) % unitice, FILE = extents (i) % fileice) WRITE(UNIT = extents (i) % unitice, FMT ='(a)') & 'spatial average values of glaciers variables' WRITE(UNIT = extents (i) % unitice, FMT ='(a,a)') & 'extent id: ', TRIM(extents (i) % id) WRITE(UNIT = extents (i) % unitice, FMT ='(a,a)') & 'extent name: ', TRIM(extents (i) % name) WRITE(UNIT = extents (i) % unitice, FMT ='(a,f15.5)') & 'extent area (km2): ', extents (i) % area / 1000. ** 2. WRITE(UNIT = extents (i) % unitice, FMT ='(a,i5)') & 'number of variables: ', countice WRITE(UNIT = extents (i) % unitice, FMT = *) WRITE(UNIT = extents (i) % unitice, FMT = '(a)') 'data' WRITE(UNIT = extents (i) % unitice, FMT = '(a)', ADVANCE = 'no' ) 'DateTime ' count = 0 DO k = 1, SIZE (iceout) IF (iceout (k) ) THEN count = count + 1 IF (count == countice) THEN !last header WRITE(UNIT = extents (i) % unitice, FMT = '(a)') TRIM(iceheader (k)) ELSE WRITE(UNIT = extents (i) % unitice, FMT = '(a,2x)', ADVANCE = 'no') & TRIM(iceheader (k)) END IF END IF END DO END DO ELSE !write spatial average values timeString = timeSpatialAverageIce DO i = 1, nextents WRITE(UNIT = extents (i) % unitice, FMT ='(a,2x, 10(E12.5,5x))') & timeString, (extents (i) % ice (k), k = 1, countice) END DO END IF RETURN END SUBROUTINE ExportSpatialAverageGlaciers !============================================================================== !| Description: ! Export spatial average of sediment variables SUBROUTINE ExportSpatialAverageSediment & ! (init) IMPLICIT NONE !arguments with intent in: LOGICAL, OPTIONAL, INTENT(IN) :: init !local declarations INTEGER (KIND = short) :: i, k, count !-------------------------------end of declaration----------------------------- IF ( countsediment == 0 ) THEN RETURN END IF IF (PRESENT (init) .AND. init ) THEN !open file and write header DO i = 1, nextents extents (i) % unitsediment = GetUnit () OPEN (UNIT = extents (i) % unitsediment, FILE = extents (i) % filesediment) WRITE(UNIT = extents (i) % unitsediment, FMT ='(a)') & 'spatial average values of sediment variables' WRITE(UNIT = extents (i) % unitsediment, FMT ='(a,a)') & 'extent id: ', TRIM(extents (i) % id) WRITE(UNIT = extents (i) % unitsediment, FMT ='(a,a)') & 'extent name: ', TRIM(extents (i) % name) WRITE(UNIT = extents (i) % unitsediment, FMT ='(a,f15.5)') & 'extent area (km2): ', extents (i) % area / 1000. ** 2. WRITE(UNIT = extents (i) % unitsediment, FMT ='(a,i5)') & 'number of variables: ', countsediment WRITE(UNIT = extents (i) % unitsediment, FMT = *) WRITE(UNIT = extents (i) % unitsediment, FMT = '(a)') 'data' WRITE(UNIT = extents (i) % unitsediment, FMT = '(a)', ADVANCE = 'no' ) 'DateTime ' count = 0 DO k = 1, SIZE (sedimentout) IF (sedimentout (k) ) THEN count = count + 1 IF (count == countsediment) THEN !last header WRITE(UNIT = extents (i) % unitsediment, FMT = '(a)') TRIM(sedimentheader (k)) ELSE WRITE(UNIT = extents (i) % unitsediment, FMT = '(a,2x)', ADVANCE = 'no') & TRIM(sedimentheader (k)) END IF END IF END DO END DO ELSE !write spatial average values timeString = timeSpatialAverageSediment DO i = 1, nextents WRITE(UNIT = extents (i) % unitsediment, FMT ='(a,2x, 10(E12.5,5x))') & timeString, (extents (i) % sediment (k), k = 1, countsediment) END DO END IF RETURN END SUBROUTINE ExportSpatialAverageSediment !============================================================================== !| Description: ! Export spatial average of canopy interception variables SUBROUTINE ExportSpatialAverageCanopy & ! (init) IMPLICIT NONE !arguments with intent in: LOGICAL, OPTIONAL, INTENT(IN) :: init !local declarations INTEGER (KIND = short) :: i, k, count !-------------------------------end of declaration----------------------------- IF ( countcanopy == 0 ) THEN RETURN END IF IF (PRESENT (init) .AND. init ) THEN !open file and write header DO i = 1, nextents extents (i) % unitcanopy = GetUnit () OPEN (UNIT = extents (i) % unitcanopy, FILE = extents (i) % filecanopy) WRITE(UNIT = extents (i) % unitcanopy, FMT ='(a)') & 'spatial average values of canopy interception variables' WRITE(UNIT = extents (i) % unitcanopy, FMT ='(a,a)') & 'extent id: ', TRIM(extents (i) % id) WRITE(UNIT = extents (i) % unitcanopy, FMT ='(a,a)') & 'extent name: ', TRIM(extents (i) % name) WRITE(UNIT = extents (i) % unitcanopy, FMT ='(a,f15.5)') & 'extent area (km2): ', extents (i) % area / 1000. ** 2. WRITE(UNIT = extents (i) % unitcanopy, FMT ='(a,i5)') & 'number of variables: ', countcanopy WRITE(UNIT = extents (i) % unitcanopy, FMT = *) WRITE(UNIT = extents (i) % unitcanopy, FMT = '(a)') 'data' WRITE(UNIT = extents (i) % unitcanopy, FMT = '(a)', ADVANCE = 'no' ) 'DateTime ' count = 0 DO k = 1, SIZE (canopyout) IF (canopyout (k) ) THEN count = count + 1 IF (count == countcanopy) THEN !last header WRITE(UNIT = extents (i) % unitcanopy, FMT = '(a)') TRIM(canopyheader (k)) ELSE WRITE(UNIT = extents (i) % unitcanopy, FMT = '(a,2x)', ADVANCE = 'no') & TRIM(canopyheader (k)) END IF END IF END DO END DO ELSE !write spatial average values timeString = timeSpatialAverageCanopy DO i = 1, nextents WRITE(UNIT = extents (i) % unitcanopy, FMT ='(a,2x, 10(E12.5,5x))') & timeString, (extents (i) % canopy (k), k = 1, countcanopy) END DO END IF RETURN END SUBROUTINE ExportSpatialAverageCanopy !============================================================================== !| Description: ! Export spatial average of plants variables SUBROUTINE ExportSpatialAveragePlants & ! (init) IMPLICIT NONE !arguments with intent in: LOGICAL, OPTIONAL, INTENT(IN) :: init !local declarations INTEGER (KIND = short) :: i, k, count !-------------------------------end of declaration----------------------------- IF ( countplants == 0 ) THEN RETURN END IF IF (PRESENT (init) .AND. init ) THEN !open file and write header DO i = 1, nextents extents (i) % unitplants = GetUnit () OPEN (UNIT = extents (i) % unitplants, FILE = extents (i) % fileplants) WRITE(UNIT = extents (i) % unitplants, FMT ='(a)') & 'spatial average values of plants variables' WRITE(UNIT = extents (i) % unitplants, FMT ='(a,a)') & 'extent id: ', TRIM(extents (i) % id) WRITE(UNIT = extents (i) % unitplants, FMT ='(a,a)') & 'extent name: ', TRIM(extents (i) % name) WRITE(UNIT = extents (i) % unitplants, FMT ='(a,f15.5)') & 'extent area (km2): ', extents (i) % area / 1000. ** 2. WRITE(UNIT = extents (i) % unitplants, FMT ='(a,i5)') & 'number of variables: ', countplants WRITE(UNIT = extents (i) % unitplants, FMT = *) WRITE(UNIT = extents (i) % unitplants, FMT = '(a)') 'data' WRITE(UNIT = extents (i) % unitplants, FMT = '(a)', ADVANCE = 'no' ) 'DateTime ' count = 0 DO k = 1, SIZE (plantsout) IF (plantsout (k) ) THEN count = count + 1 IF (count == countplants) THEN !last header WRITE(UNIT = extents (i) % unitplants, FMT = '(a)') TRIM(plantsheader (k)) ELSE WRITE(UNIT = extents (i) % unitplants, FMT = '(a,2x)', ADVANCE = 'no') & TRIM(plantsheader (k)) END IF END IF END DO END DO ELSE !write spatial average values timeString = timeSpatialAveragePlants DO i = 1, nextents WRITE(UNIT = extents (i) % unitplants, FMT ='(a,2x, 15(E12.5,5x))') & timeString, (extents (i) % plants (k), k = 1, countplants) END DO END IF RETURN END SUBROUTINE ExportSpatialAveragePlants END MODULE SpatialAverage